home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / general / hdf / unix / hdf3_2r2.lha / HDF3.2r2 / bkwdtest / rs3f.f < prev    next >
Encoding:
Text File  |  1992-10-29  |  6.9 KB  |  232 lines
  1.       program rs3f
  2. C
  3. C Program to read 3 SDSs from  bctest.hdf which contains an
  4. C SDS written by ws.c, an SDS written by wsf.f and one by wsf31.f.
  5. C It then print a table of the contents of each SDG for comparisons.
  6. C SDG/1 -- SDG/2 should have the same internal memory storage
  7. C sequence in terms of the data arrays; the dimension sizes
  8. C in C are reversed comparing with those in Fortran. 
  9. C In hdf file 3231hdf.dat, these two SDGs should have the same
  10. C sequences in terms of dimension sizes, dim scales, dim strings,
  11. C and data arrays.
  12. C 
  13. C Input file: bctest.hdf
  14.  
  15.  
  16.       integer dsgdata, dsgdims, dsgdisc, dsgdist, dsgrang
  17.       integer dspre32
  18.       integer ret, np, nr,nc, di(3)
  19.       integer id1(3),id2(3),id3(3), ispre32
  20.       integer rank,irank1,irank2,irank3
  21.       real    scpln(2), scrow(3), sccol(4), da(4,3,2)
  22.       real    maxi, mini
  23.       real    iscpln1(4), iscrow1(4), isccol1(4), ida1(4,3,2)
  24.       real    iscpln2(4), iscrow2(4), isccol2(4), ida2(4,3,2)
  25.       real    iscpln3(4), iscrow3(4), isccol3(4), ida3(4,3,2)
  26.       real    imaxi(3), imini(3)
  27.       integer i, j, k, no_err
  28.       character*7 l0(3), u0(3), fm0(3)
  29.       character*15 fn
  30. C      character*15 rslfn
  31.       character*12 il1(3),iu1(3), ifm1(3)
  32.       character*12 il2(3),iu2(3), ifm2(3)
  33.       character*12 il3(3),iu3(3), ifm3(3)
  34.  
  35.       di(1) = 4
  36.       di(2) = 3
  37.       di(3) = 2
  38.       np = 2
  39.       nr = 3
  40.       nc = 4
  41.       rank = 3
  42.       scpln(1) =   0.0
  43.       scpln(2) = 100.0
  44.       scrow(1) =   0.0
  45.       scrow(2) =  10.0
  46.       scrow(3) =  20.0
  47.       sccol(1) =   0.0
  48.       sccol(2) =   1.0
  49.       sccol(3) =   2.0
  50.       sccol(4) =   3.0
  51.       maxi = 123.0
  52.       mini = -1.0
  53.       l0(1) = 'Column'
  54.       u0(1) = 'Cm'
  55.       fm0(1) = 'Int32'
  56.       l0(2) = 'Line'
  57.       u0(2) = 'Inch'
  58.       fm0(2) = 'Int16'
  59.       l0(3) = 'Time'
  60.       u0(3) = 'Second'
  61.       fm0(3) = 'Int32'
  62.       fn = 'bctest.hdf'
  63. C      rslfn = 'rs3f.rsl'
  64.       no_err = 0
  65.  
  66.       do 200 i=1, np
  67.          do 180 j=1, nr
  68.             do 150 k=1, nc
  69.         da(k,j,i) = scpln(i) + scrow(j) + sccol(k)
  70. C             print *, da(k,j,i)
  71. 150        continue
  72. 180      continue
  73. 200   continue
  74.  
  75.           ret = dsgdims(fn, irank1, id1, 3)
  76.           no_err = no_err + ret
  77.           ispre32 = dspre32()
  78.           if (ispre32 .eq. 0) then
  79.               print *, 'SDG1 was written by HDF3.2'
  80.           else 
  81.               print *, '>>>>>>>>>>>>>>>>>>>>>>>>>'
  82.               print *, 'dspre32() returned wrong value for SDG1'
  83.               no_err = no_err-1
  84.           endif
  85.           do 250 i=1, rank
  86.               ret = dsgdist(i, il1(i), iu1(i), ifm1(i))
  87.               no_err = no_err + ret
  88. 250       continue
  89.           ret = dsgdisc(1, id1(1), isccol1)
  90.           no_err = no_err + ret
  91.           ret = dsgdisc(2, id1(2), iscrow1)
  92.           no_err = no_err + ret
  93.           ret = dsgdisc(3, id1(3), iscpln1)
  94.           no_err = no_err + ret
  95.           ret = dsgrang(imaxi(1), imini(1))
  96.           no_err = no_err + ret
  97.           ret = dsgdata(fn, irank1, id1, ida1)
  98.           no_err = no_err + ret
  99.  
  100.           ret = dsgdims(fn, irank2, id2, 3)
  101.           no_err = no_err + ret
  102.           ispre32 = dspre32()
  103.           if (ispre32 .eq. 0) then
  104.               print *, 'SDG2 was written by HDF3.2'
  105.           else
  106.               print *, '>>>>>>>>>>>>>>>>>>>>>>>>>'
  107.               print *, 'dspre32() returned wrong value for SDG2'
  108.               no_err = no_err-1
  109.           endif
  110.  
  111.           do 300 i=1, rank
  112.               ret = dsgdist(i, il2(i), iu2(i), ifm2(i))
  113.               no_err = no_err + ret
  114. 300       continue
  115.           ret = dsgdisc(1, id2(1), isccol2)
  116.           no_err = no_err + ret
  117.           ret = dsgdisc(2, id2(2), iscrow2)
  118.           no_err = no_err + ret
  119.           ret = dsgdisc(3, id2(3), iscpln2)
  120.           no_err = no_err + ret
  121.           ret = dsgrang(imaxi(2), imini(2))
  122.           no_err = no_err + ret
  123.           ret = dsgdata(fn, irank2, id2, ida2)
  124.           no_err = no_err + ret
  125.  
  126.           ret = dsgdims(fn, irank3, id3, 3)
  127.           no_err = no_err + ret
  128.           ispre32 = dspre32()
  129.           if (ispre32 .eq. 1) then
  130.               print *,'SDG3 was written by HDF prior to 3.2'
  131.           else
  132.               print *, '>>>>>>>>>>>>>>>>>>>>>>>>>'
  133.               print *, 'dspre32() returned wrong value for SDG3'
  134.               no_err = no_err-1
  135.           endif
  136.           do 350 i=1, rank
  137.               ret = dsgdist(i, il3(i), iu3(i), ifm3(i))
  138.               no_err = no_err + ret
  139. 350       continue
  140.           ret = dsgdisc(1, id3(1), isccol3)
  141.           no_err = no_err + ret
  142.           ret = dsgdisc(2, id3(2), iscrow3)
  143.           no_err = no_err + ret
  144.           ret = dsgdisc(3, id3(3), iscpln3)
  145.           no_err = no_err + ret
  146.           ret = dsgrang(imaxi(3), imini(3))
  147.           no_err = no_err + ret
  148.           ret = dsgdata(fn, irank3, id3, ida3)
  149.           no_err = no_err + ret
  150.  
  151. C 
  152. C Print results
  153. C
  154.  
  155. C      OPEN(UNIT=8, FILE=rslfn, STATUS='new')
  156. C      print *,'>>> rs3f:',abs(no_err),' calls failed >>>'
  157.       write(*, *)  '                     Print Results'
  158.       write(*, *) '        Origl  SDG/1  SDG/2  SDG/3  '
  159.       write (*, 560) rank, irank1,irank2,irank3
  160. 560   format (1x,4Hrank, 1x, 4I7)
  161.  
  162.       do 600 i=1,3
  163.           write (*,605) i, di(i),id1(i),id2(i), id3(i)
  164. 600   continue
  165. 605   format (1x,3Hdim,I1,2x,4(1x,I5,1x))
  166.  
  167.       do 610 i=1,4
  168.           write (*,612) i, sccol(i),isccol1(i),isccol2(i),
  169.      *            isccol3(i)
  170. 610   continue
  171. 612   format (5Hd1_sc,I1,1x,4(1x,F5.1,1x))
  172.  
  173.       do 615 i=1,3
  174.           write (*,618) i,scrow(i),iscrow1(i),iscrow2(i),
  175.      *        iscrow3(i)
  176. 615   continue
  177. 618   format (5Hd2_sc,I1,1x,4(1x,F5.1,1x))
  178.  
  179.       do 620 i=1,2
  180.           write (*,625) i,scpln(i),iscpln1(i),iscpln2(i),
  181.      *         iscpln3(i)
  182. 620   continue
  183. 625   format (5Hd3_sc,I1,1x,4(1x,F5.1,1x))
  184.  
  185.       write (*,631) maxi,imaxi(1),imaxi(2), 
  186.      *        imaxi(3)
  187. 631   format (4Hmaxi,3x,4(1x,F5.1,1x))
  188.  
  189.       write (*,635) mini,imini(1),imini(2),imini(3)
  190. 635   format (4Hmini,3x,4(1x,F5.1,1x))
  191.  
  192.       write (*,638)  l0(1),il1(1),il2(1),il3(1)
  193. 638   format (6Hlabel1,1x,4(A6,1x))
  194.       write (*,642)  l0(2),il1(2),il2(2),il3(2)
  195. 642   format (6Hlabel2,1x,A6,1x,2(A4,3x),1(A6,1x))
  196.       write (*,648)  l0(3),il1(3),il2(3),il3(3)
  197. 648   format (6Hlabel3,1x,A6,1x,2(A4,3x),1(A6,1x))
  198.  
  199.       write (*,650) u0(1),iu1(1),iu2(1),iu3(1)
  200. 650   format (1x, 5Hunit1,1x,A6,1x,2(A2,5x),1(A6,1x))
  201.       write (*,654) u0(2),iu1(2),iu2(2),iu3(2)
  202. 654   format (1x, 5Hunit2,1x,A6,1x,2(A4,3x),1(A6,1x))
  203.       write (*,658) u0(3),iu1(3),iu2(3),iu3(3)
  204. 658   format (1x, 5Hunit3,1x,4(A6,1x))
  205.  
  206.       do 660 i=1,3
  207.           write (*,665) fm0(i),ifm1(i),ifm2(i),ifm3(i)
  208. 660   continue
  209. 665   format (6Hformat,1x,A6,2(1x,A5,1x),1(1x,A6))
  210.  
  211.       write(*, *)  'Data:'
  212.       do 1000 i=1,np
  213.           do 900 j=1,nr
  214.               do 800 k=1,nc
  215.                  write (*, 1005) k,j,i, da(k,j,i),ida1(k,j,i),
  216.      *           ida2(k,j,i),ida3(k,j,i)
  217. 800           continue
  218. 900       continue
  219. 1000   continue
  220. 1005   format (3I2, 4(1x,F5.1,1x))
  221.  
  222.       print *,'>>> rs3f:',abs(no_err),' calls failed >>>'
  223.  
  224.       stop 
  225.       end
  226.  
  227.  
  228.      
  229.  
  230.  
  231.  
  232.